home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.3 / Video Toaster v4.3.iso / 3.1 / toasterall / arexx_examples / lwm / text.lwm < prev    next >
Text File  |  1993-06-08  |  6KB  |  274 lines
  1. /* CMD: Text
  2.  * By Arnie Cachelin © 1993 NewTek Inc. */
  3. /* Mon May 31 15:53:20 1993 */
  4.  
  5. libadd = addlib("LWModelerARexx.port",0)
  6. signal on error
  7. signal on syntax
  8.  
  9. call addlib "rexxsupport.library", 0, -30, 0
  10. MATHLIB="rexxmathlib.library"
  11. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  12.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  13.     call notify(1,"!Can't find "MATHLIB)
  14.     exit
  15.     END
  16. sysnam = 'Compose Text Lines'
  17. filnam = 'ENV:Text.state'
  18. version = 'Text v1.0'
  19. lead=50
  20. typ=1
  21. just=1
  22. deep = 0.1
  23. wide = 0.02
  24. lines=4
  25. line.=""
  26. if (exists(filnam)) then do
  27.     if (~open(state, filnam, 'R')) then break
  28.     if (readln(state) ~= version) then break
  29.     parse value readln(state) with lead typ just .
  30.     do i=1 to lines
  31.       line.i = readln(state)
  32.     end
  33.     call close state
  34. end
  35.  
  36. call req_begin sysnam
  37. styles = 'Flat Block Chisel Round'
  38.  
  39. id_font = req_addcontrol("Font", 'F')
  40. id_typ = req_addcontrol("Text Type", "CH",Styles)
  41. id_just = req_addcontrol('Place','CH',"Center Left Right Justify Scale")
  42. id_deep = req_addcontrol("Depth", 'n', 1)
  43. id_wide = req_addcontrol("Edge Width", 'n', 1)
  44. do i=1 to lines
  45.   id_line.i = req_addcontrol("> ", 's', 35)
  46.   end
  47. id_lead = req_addcontrol("% Leading", 'n')
  48.  
  49. do i=1 to lines
  50.   call req_setval id_line.i, line.i
  51.   end
  52. line.i=""
  53.  
  54. call req_setval id_lead, lead,lead
  55. call req_setval id_just, just,1
  56. call req_setval id_typ, typ,1
  57. call req_setval id_deep, deep,0.1
  58. call req_setval id_wide, wide,0.02
  59.  
  60. if (~req_post()) then do
  61.     call req_end
  62.     exit
  63. end
  64. LineLen=0
  65. font = req_getval(id_font)
  66. do i=1 to lines
  67.   line.i = req_getval(id_line.i)
  68.   if length(line.i)>LineLen then do
  69.     LineLen=length(line.i)
  70.     longest=line.i
  71.     end
  72.   end
  73. lead = req_getval(id_lead)%1
  74. just = req_getval(id_just)-1
  75. typ = req_getval(id_typ)
  76. wide = req_getval(id_wide)
  77. deep = req_getval(id_deep)
  78. call req_end
  79.  
  80. if (open(state, filnam, 'W')) then do
  81.     call writeln state, version
  82.     call writeln state, lead typ just+1
  83.     do i=1 to lines
  84.       call writeln state, line.i
  85.     end
  86.     call close state
  87. end
  88.  
  89.  
  90. if LineLen=0 then exit
  91. call CUT()
  92. if font=0 then do
  93.   if(notify(2,"!Please Load A Font!","I can't continue without one")) then do
  94.     fname=GetFileName("Load Font","/ToasterFonts")
  95.     if fname~="(none)" then do
  96.       font=fontload(fname)
  97.       if font=0 then do
  98.         call notify(1,"!Can't load font "fname)
  99.         exit
  100.         end
  101.       end
  102.     end
  103.   end
  104.  
  105. LineWidth=MAKETEXT(longest,font,'B',wide*2)
  106. if LineWidth~=0 then call UNDO()
  107. call PASTE()
  108. /* call surface(surf) */
  109. /* call meter_begin lines+2, "Creating Formatted Text Object" */
  110. /* call meter_step() */
  111. h=CreateText(line.1, typ,just)
  112. stmarg=h + lead*h/100
  113. do i=2 to lines
  114. /*   call meter_step() */
  115.   if line.i~="" then do
  116.     say i h lead typ
  117.     marg=h + lead*h/100
  118.     if type=4 then call MOVE(0 marg 0)
  119.     else call MOVE(0 stmarg 0)
  120.     h=CreateText(line.i, typ)
  121.     say h
  122.     end
  123. end
  124. box=boundingbox()
  125. parse var box n x1 x2 y1 y2 z1 z2
  126. call MOVE(0 0-y1 0)
  127. /* call meter_end() */
  128. if (libadd) then call remlib("LWModelerARexx.port")
  129. exit
  130.  
  131. syntax:
  132. error:
  133.   call end_all
  134.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  135.   if (libadd) then call remlib("LWModelerARexx.port")
  136.     exit
  137.  
  138. Center: Procedure
  139.   box=boundingbox()  /* Should check out empty list ...  */
  140.   parse var box n x1 x2 y1 y2 z1 z2
  141.   cx=-(x2-x1)/2
  142.   cy=-(y2-y1)/2
  143.   cz=-(z2-z1)/2
  144.   call MOVE(cx cy cz)
  145.   return box
  146.  
  147. CenterX: Procedure
  148.   box=boundingbox()  /* Should check out empty list ...  */
  149.   parse var box n x1 x2 y1 y2 z1 z2
  150.   cx=-(x2-x1)/2
  151.   call MOVE(cx 0 0)
  152.   return (y2-y1) /* Height */
  153.  
  154. CenterScaleX: Procedure
  155.   arg w
  156.   box=boundingbox()  /* Should check out empty list ...  */
  157.   parse var box n x1 x2 y1 y2 z1 z2
  158.   cx=-(x2-x1)/2
  159.   call MOVE(cx 0 0)
  160.   call SCALE(w/2*cx 1 1,0)
  161.   return (y2-y1) /* Height */
  162.  
  163. JustifyX: Procedure expose marg  /* 0=center, left=1, 2=right 3=justify 4=Aspect Justify*/
  164.   arg w, type
  165.   say w type
  166.   box=boundingbox()  /* Should check out empty list ...  */
  167.   parse var box n x1 x2 y1 y2 z1 z2
  168.   cx=-(x2-x1)/2
  169.   cy=(y2-y1)/2
  170.   select
  171.     when type=4 then do
  172.       call MOVE(cx 0 0)
  173.       call SCALE(w/(-2*cx) w/(-2*cx) 1,0 y2 0)
  174.       end
  175.     when type=3 then do
  176.       call MOVE(cx 0 0)
  177.       call SCALE(w/(-2*cx) 1 1,0)
  178.       end
  179.     when type=2 then call MOVE(2*cx 0 0)
  180.     when type=0 then call MOVE(cx 0 0)
  181.     otherwise nop
  182.     end
  183. if type=4 then return (y2-y1)*w/(-2*cx) /* Height */
  184. else return (y2-y1)
  185.  
  186. Bevel_Slab:
  187.   txlayer=curlayer()
  188.   empty=emptylayers()
  189.   if empty~="" then do
  190.     slablayer=word(empty,1)
  191.     end
  192.   else do    /* Need 1 layer to transform in */
  193.     call notify(1,'!'sysnam,'@Sorry, No Scratch Layer Available')
  194.     return
  195.     end
  196.   box=boundingbox()
  197.   parse var box n x1 x2 y1 y2 z1 z2
  198.   z2=z1+deep*2
  199.   call surface("Slab")
  200.   call MAKEBOX(x1 y1 z1, x2 y2 z2)
  201.   call smoothshift(wide)
  202.   call setblayer(txlayer)
  203.   call BOOLEAN(SUBTRACT)
  204.   call setlayer(txlayer)
  205.   call Cut()
  206.   call setlayer(slablayer)
  207.   call Cut()
  208.   call setlayer(txlayer)
  209.   call Paste()
  210.   return
  211.  
  212. Bevel_Flat:
  213.     return
  214.  
  215. Bevel_Block:
  216.     call bevel(0, deep / 2)
  217.     return
  218.  
  219. Bevel_Chisel:
  220.     call shapebevel(-wide wide (-wide) deep/2)
  221.     return
  222.  
  223. Bevel_Round:
  224.     n = 5
  225.     pat = ''
  226.     do i=1 to n
  227.         a = 3.14159/2 * i / n
  228.         pat = pat (-sin(a)*wide) (1-cos(a))*wide
  229.       end i
  230.     call shapebevel(pat (-wide) deep/2)
  231.     return
  232.  
  233. CreateText: PROCEDURE expose font wide styles deep just LineWidth
  234.   arg txt,typ
  235.   say txt typ
  236.   origl = curlayer()
  237.   empty = emptylayers()
  238.   if (words(empty) < 2) then do
  239.     call notify 1,syscode,"!Need at least two empty layers","!for this operation."
  240.     exit
  241.     end
  242.   sl1 = word(empty, 1)
  243.   sl2 = word(empty, 2)
  244.   sbase = ''
  245.   do i=1 to words(txt)
  246.     sbase = sbase || word(txt, i)
  247.     if length(sbase) >= 5 then leave
  248.     end
  249.   if length(sbase) > 15 then sbase = left(sbase, 15)
  250.   corners = 'B B S S S'
  251.   call setlayer sl1
  252.   w= maketext(txt, font, word(corners, typ), wide * 2)
  253.   call copy
  254.   call setlayer sl2
  255.   call paste
  256.   call sel_mode('user')
  257.   call sel_polygon('set')
  258.   interpret 'call Bevel_' || word(styles, typ)
  259.   call cut
  260.   call changesurface(sbase || "_Side")
  261.   call setlayer sl1 /* Get the correct faces from sl1. */
  262.   call changesurface(sbase || "_Face")
  263.   call flip
  264.   call cut
  265.   call setlayer sl2
  266.   call paste
  267.   call mirror(Z, -deep/2)
  268.   call mergepoints
  269.   x=JustifyX(LineWidth,just)
  270.   call cut
  271.   call setlayer origl
  272.   call paste
  273.   return x
  274.